perm filename ITMSBX.OLD[MSS,LCS] blob sn#107250 filedate 1974-06-15 generic text, type T, neo UTF8
C**** ITMSUB, RNOTE ********
C  ********** WHOLE & HALF RESTS, BEAMS ******
	SUBROUTINE ITMSUB
	IMPLICIT INTEGER(A-Q,S-Z)
	REAL DIS,PWDS,DISX,HGT,POS,CENTR,STFF,HGT1
	COMMON/STF/RSTFAC(8),RSTJC/MIN/MINI,RMINI
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/BM/RA,RC,RJY
	COMMON/POSI/STFF(8),JJB,POS/PLTR/PLT,RHT,DIS
	EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
	1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
	1,(JK,JQ(9)),(JF,JQ(4)),(RJI,RJQ(7)),(RJH,RJQ(6))
	1 ,(RJG,RJQ(5)),(RJD,RJQ(2)),(RJI,RJQ(7)),(RJJ,RJQ(8))
	DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/
	RST7=RSTJC*7.
	RST18=RSTJC*18.
C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0

	RJBQ=JB
	JY=0
	IF(JA.EQ.9)GO TO 90
	IF(JA.EQ.10)GO TO 100
C  GO TO LINES, BEAMS, STAVES.
C   NEXT DRAWS STRAIGHT LINES

	RD=RJD*RST7
	RA=0
C WHY "*RSTJC"????
	RX=RTF+POS
	IF(JE.EQ.50)GO TO 300
	IF(RJF.GT.0)GO TO 401
C  FOR BAR LINES
	JA=44
C  CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
	IF(JG)GO TO 407
	IF(JG.EQ.0)JG=JD/100
	RA=1
	IF(PLT.GE.0)GO TO 40
	JG=JG+1
	RA=1./DIS
C  BAR LINES PLOT AS DOUBLE THICKNESS
40	RX=RTF*RSTJC+POS
	L=MOD(JD,100)+JC+3
C JD=401 MAKES 4X THICK BARLINE - ONE STAFF
	RY=STFF(L)+.5+RSTFAC(L)*58.
	RW=RY
	RJX=RJBQ
42	CALL LINES(RJBQ,RX,3)
	IF(JG.EQ.-2)GO TO 404
C  IF JG<0 THEN WIGGLEY LINES ARE MADE.
	RJ=-1.
406	CALL LINES(RJX,RY,2)
	IF(JG.LE.0)RETURN
C  FOR 'HEAVY' LINE.
	RJX=RJX+RA
	CALL LINES(RJX,RY,2)
	JG=JG-1
	RY=RW
	IF(RJ)RY=RX
	RJ=-RJ
	GO TO 406
43	IF(RA.GT.0)GO TO 403
	RETURN
C   HOV IS RA.NE.0?
C  DRAWS BAR LINES. JD>0 CAUSES FULL LINE.
403	RA=RA-3.72
	RJBQ=RJBQ+22
	RJX=RJX+22
C   DO ABOVE NEED *RSTJC? ************
C **** BASED ON '596' ****
	GO TO 42

C  FOR CRESC., DECRESC.
300	RA=ABS(RJG/2.0)*RST7
C   AMOUNT OF SPREAD
	RJ=RJBQ
	RX=RX-RST18+RD
	IF(RJH.NE.0)GO TO 302
C  JUMP TO MAKE BOX
	RJF=RHORZ(RJF)
	IF(RJG)GO TO 301
	RJ=RJF
	RJF=RJBQ
301	CALL LINX(RJ,RX+RA,RJF,RX)
	CALL LINES(RJ,RX-RA,2)
C  FOR CRESC, DECRESC: 4 POS1, STF, HGT, 50, POS1, +OR-N
	RETURN

302	RJH=RJH*RST7
	RJI=RJI*RST7
	IF(RJI.EQ.0)RJI=RJH
	RJB=RJBQ-RJH/2.
	RX=RX-RJI/2.
C  DRAWS BOX, CENTER IS IN MIDDLE 
C  4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
	CALL LINX(RJB,RX,RJB+RJH,RX)
	CALL LINES(RJB+RJH,RX+RJI,2)
	CALL LINES(RJB,RX+RJI,2)
	CALL LINES(RJB,RX,2)
	RETURN

C  DASHES
401	POS=POS-RST18
C********* 27/9/72 ******
	IF(JG.EQ.0)GO TO 407
	IF(ABS(RJF-RJB).LT..01)GO TO 402
C VERTICAL DASHES IF P6=P2
	RA=RJF-RJB-4.
	RJF=RJB+2
	IF(JG.GT.0)JG=0
	GO TO 407
402	RA=POS+RJE*RST7
	IF(RJH.EQ.0)RJH=.8
C  P8 CAN SET SIZE OF DASH
	RJ=RJH*RST7
	RX=RD+POS
	L=3
	K=2
41	IF(RX.GT.RA)RETURN
C  DASHES MUST GO FROM BOTTOM TO TOP.
	CALL LINES(RJBQ,RX,L)
	RX=RX+RJ
	CALL EXCH(K,L)
	GO TO 41
407	RX=RD+POS
	RY=RJE*RST7+POS
	IF(JG.EQ.-1)GO TO 408
C  FOR 'TR' JG=-2, 'ARPEGG' JG=-1
	RJX=IFIX(RHORZ(RJF))
	GO TO 42
C  DRAWS STRAIGHT LINES. ETC.
404	L=(RA+4)/1.5
	RJ=RY
	DO 405 K=1,L
	CALL LINES(RJX,RJ,2)
	RJX=RJX+9
C   *RSTJC?
405	CALL EXCH(RX,RJ)
	RETURN

408	IF(RX.GT.RY)CALL EXCH(RX,RY)
	RA=4.
	IF(RJH.NE.0)RA=RJH*4.
C  USE P8 TO SET WIGGLE WIDTH.  (HGT CANNOT BE CHANGED YET..)
	RX=RX-12.*RSTJC
	RJ=6.*RSTJC
	RJX=4*RSTJC
	RW=RJBQ-RJX
	CALL LINES(RW,RX-RJ,3)
	RJX=RA*RSTJC
410	CALL LINES(RJBQ+RJX,RX,2)
	CALL LINES(RW,RX+RJ,2)
	RX=RX+12.*RSTJC
	IF(RX.LT.RY)GO TO 410
	RETURN
C  VERTICAL WIGGLE


C  NEXT IS FOR BEAMS
90	RMINI=RSTJC
	RX=2.7*RSTJC
C******************************
	IF(JJ.LT.10)GO TO 91
C NEXT FOR INNER, PARTIAL BEAMS
	RJJ=AMOD(RJJ,10.)
	GO TO(2,3,4),JJ/10
2	RJH=RJI+RX
	GO TO 4
3	RJH=RJI-RX
C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
4	RH=RHORZ(RJH)
C  LEFT INNER POS.
	GO TO 1
C******************************
91	IF(JH.GE.0)GO TO 1
92	RJI=RJB+RX
	IF(JH.LE.-20)RJI=RJF-RX
192	JH=-JH
	IF(JJ.EQ.0)JJ=MOD(JH,10)
	JH=JH-JJ
	IF(JJ.EQ.0)JJ=1
	RJJ=JJ
C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
1	IF(IABS(JD).LT.100)GO TO 97
	RMINI=.6*RSTJC
	RJE=AMOD(RJE,100.0)
C   SPACE BETWEEN BEAMS
97	RJ=RMINI*11.
	RW=RMINI*RHGT
C  DIST. UP OR DOWN FROM NOTE HEAD.
	RJA=RJJ*RJ
C  DISPLACEMENT
	RD=RHORZ(ABS(RJI))
C  POSITION 3
	RJX=CENTR-RW+RJA
C  FINAL HEIGHT
CC??????	RX=MOD(JG,10)-MOD(JH,10)
	RX=MOD(JG,10)
	JJB=JG-20
	RA=RHORZ(RJF)
C  HORIZANTAL DIST.
	RJY=RJE*RST7+POS-RST18-RW+RJA
C************************
	RW=R14*RMINI
	IF(JG.GE.20)GO TO 93
C JUMP IF STEMS ARE DOWN
	JJB=JG-10
	RJ=-RJ
CCAUG.7,73	RJA=RMINI*R2HGT-2.*RJA-3.
	RY=-3
	IF(RMINI.LT..65)RY=-1
	RJA=RMINI*R2HGT-2.*RJA+RY
	RJX=RJX+RJA
	RJY=RJY+RJA
	RJBQ=RJBQ+RW
C  POSITION 1
	RA=RA+RW
C  POSITION 2
	RD=RD+RW
C******************************
	RH=RH+RW
93	IF(JJB.GT.RX)GO TO 94
	IF(JJ.GE.10)GO TO 7
C**********************
	IF(JH.EQ.0)GO TO 94
	RJC=RW
C******************************
	IF(RJI.EQ.0)GO TO 292
 	IF(JH.GE.20)GO TO 193
C******************************
CC	IF(JI.GT.0)GO TO 293
293	RX=RJBQ-RD
	GO TO 194
C******************************
7	RHX=RH-RJBQ
CC	RJC=RX-RJBQ
	RJC=RD-RJBQ
	GO TO 292
193	RX=RD-RA
194	RJC=ABS(RX)
292	DISX=ABS(RJBQ-RA)
	HGT=RJX-RJY
	IF(JJ.GE.10)HGT1=HGT*RHX/DISX
C**********************
	RJC=RJC/DISX
195	HGT=HGT*RJC
196	L=JH/10
	JH=0
	IF(JJ.GE.10)GO TO 8
C***************
	IF(L.EQ.1)GO TO 95
C   BEAM LFT=1,  RT=2   (PARAM 8=10 OR 20)
	RJBQ=RD
	RJX=RJY+HGT
	GO TO 94
C**************
8	RJBQ=RH
	RA=RD
	RJY=RJX-HGT
	RJX=RJX-HGT1
	GO TO 94
95	RA=RD
	RJY=RJX-HGT
94	RC=0
	L=6
	IF(RMINI.LT..65)L=3
	CALL LINES(RJBQ,RJX,3)
	DO 941 K=1,L
	CALL BMS
	IF(PLT.GE.0)GO TO 940
	RC=RC+1
	CALL BMS
	CALL EXCH(RA,RJBQ)
941	CALL EXCH(RJY,RJX)
	CALL BMS
C  DRAWS 5 LINES FOR BEAMS.
940	JJB=JJB-1
	IF(JJB.LE.0)RETURN
C  IF P7=10 OR 20 ONE BEAM WILL APPEAR.
	RJY=RJY+RJ
	RJX=RJX+RJ
	GO TO 93

100	RA=0
	RJB=RHORZ(RJB)
	RJ=RHORZ(FLOAT(JD))
	IF(JD.EQ.0)RJ=596
C  FOR STAFF LINES: 10, POS 1, HGT(3 TO -3), 2ND POS., UP-DOWN(NT #S)
	JC=JC+4
	IF(RJF.EQ.0)RJF=RSTFAC(JC)
	IF(RJF.EQ.0)RJF=1.
	RSTFAC(JC)=RJF
	STFF(JC)=(JC-1)*123-369.+RJE*7.*RJF
	RX=STFF(JC)+RTF*RJF
C  FOR RTF SEE DATA
C  FOR 2 PASS PLOTTING
	RJF=RJF*14.
	DO 6 K=1,5
	RZ=RJ
	RW=RJB
	IF(K.EQ.2.OR.K.EQ.4)CALL EXCH(RW,RZ)
	CALL LINX(RZ,RX,RW,RX)
6	RX=RX+RJF
	END

	SUBROUTINE BMS
	COMMON/STF/RSTFAC(8),RSTJC/BM/RA,RC,RJY
	CALL LINES(RA,RJY+RC*RSTJC,2)
	END

	SUBROUTINE METER
	COMMON /STF/RSTFAC(8),RSTJC
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJD,RJQ(2))
	1,(RJF,RJQ(4)),(JF,JQ(4)),(RJE,RJQ(3)),(RJG,RJQ(5))
	1,(RJH,RJQ(6)),(RJG,RJQ(5))

C  PARAMS  18 / POS / STF / TOP NUM/ BOT NUM/ VERT.HGT/ SIZE FAC.

	KC=10.*RSTJC+JB
	JX=JB
	JA=5
	RJE=RJG
	IF(RJE.EQ.0)RJE=1.
	IF(JD.GT.9)GO TO 10
	IF(JE.GT.9)GO TO 20
	M=2
	JF=JD
19	RJD=(8.+RJF)*RJE
C   MULTS BY SIZE FACTOR
9	CALL NOTWRT
	GO TO (1,2,3,4,5),M
1	RETURN

C  ****** 4/(4) *****
2	JF=JE
	M=1
11	RJD=(4.+RJF)*RJE
	GO TO 9

C ******* (1)2/16 *******
10	JF=JD/10
	M=3
	GO TO 19

C ****** 1(2)/16 *******
3	M=4
39	JB=JB+20.*RSTJC
	JF=MOD(JD,10)
	GO TO 9

4	IF(JE.LT.9)GO TO 30
C ******** 12/(1)6 ******
	JB=JX
	JF=JE/10
	M=5
	GO TO 11

C ******* 12/1(6) ********
5	JD=JE
	M=1
	GO TO 39

C ********* 12/(8) ********
30	JB=KC
	GO TO 2

C ******** 4/16 *******
20	M=4
	JB=KC
	JF=JD
	GO TO 19
	END

	SUBROUTINE RNOTE(X)
	COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
	X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
	END